LB4 enables subs to be used as event handlers. This example makes use of subs to handle left, middle and right mouse clicks inside graphicboxes. As if by magic, the sub receives the handle of the graphicbox and the mouse x/y coordinates within the graphicbox with no effort required by the programmer! So it is very easy to identify one graphicbox out of many and then get the position of the mouse pointer within the box where the mouse button was clicked.
By numbering the graphicboxes sequentially, any box clicked can be identified by extracting the serial number from the handle of the box. LB4 then conveniently passes that serial number to your sub event handler. In the example code, all graphicboxes have a handle #w1.g?? so extracting mid$(#w1.g??,6) will identify the box clicked. By further subdividing the graphicboxes with drawn lines, the retrieved mouse x/y values are then conveniently passed to your sub. An analysis of the x/y values can then easily identify each subdivision. Each graphicbox is subivided into sections A, B and C, making 144 individual 'cells'. This simple bit of code enables any one of those 144 cells to be identified.
I have also taken the opportunity to remind you that LB4 introduces detection of the middle mouse button. Clicking your middle mouse button anytime during this demo will give you the x,y values of the mouse pointer.
I recently had the need to quickly put together some code to enable the production of a conference seating plan. The code below formed the basis of the method used to provide a GUI to allow seats to be selected and allocated. You will need to add your own routines to load or save data to/from a file when the application is opened or closed.
'Start of code
if left$(Version$,1)<>"4" then
notice "IMPORTANT";chr$(13);"This program needs LB version 4."
end
end if
dim seatA$(48,48),seatB$(48,48),seatC$(48,48)
for i=1 to 48
seatA$(1,i)="Available"
seatB$(1,i)="Available"
seatC$(1,i)="Available"
next i
nomainwin
st$="Left click a seat to allocate. "+chr$(13)+"Right click to cancel the seat."+_
chr$(13)+"(Middle button to get MouseX/MouseY)"
WindowWidth=DisplayWidth:WindowHeight=DisplayHeight
graphicbox #w1.g1, 0,0,100,50
graphicbox #w1.g2, 100,0,100,50
graphicbox #w1.g3, 200,0,100,50
graphicbox #w1.g4, 300,0,100,50
graphicbox #w1.g5, 400,0,100,50
graphicbox #w1.g6, 500,0,100,50
graphicbox #w1.g7, 600,0,100,50
graphicbox #w1.g8, 700,0,100,50
graphicbox #w1.g9, 0,50,100,50
graphicbox #w1.g10, 100,50,100,50
graphicbox #w1.g11, 200,50,100,50
graphicbox #w1.g12, 300,50,100,50
graphicbox #w1.g13, 400,50,100,50
graphicbox #w1.g14, 500,50,100,50
graphicbox #w1.g15, 600,50,100,50
graphicbox #w1.g16, 700,50,100,50
graphicbox #w1.g17, 0,100,100,50
graphicbox #w1.g18, 100,100,100,50
graphicbox #w1.g19, 200,100,100,50
graphicbox #w1.g20, 300,100,100,50
graphicbox #w1.g21, 400,100,100,50
graphicbox #w1.g22, 500,100,100,50
graphicbox #w1.g23, 600,100,100,50
graphicbox #w1.g24, 700,100,100,50
graphicbox #w1.g25, 0,150,100,50
graphicbox #w1.g26, 100,150,100,50
graphicbox #w1.g27, 200,150,100,50
graphicbox #w1.g28, 300,150,100,50
graphicbox #w1.g29, 400,150,100,50
graphicbox #w1.g30, 500,150,100,50
graphicbox #w1.g31, 600,150,100,50
graphicbox #w1.g32, 700,150,100,50
graphicbox #w1.g33, 0,200,100,50
graphicbox #w1.g34, 100,200,100,50
graphicbox #w1.g35, 200,200,100,50
graphicbox #w1.g36, 300,200,100,50
graphicbox #w1.g37, 400,200,100,50
graphicbox #w1.g38, 500,200,100,50
graphicbox #w1.g39, 600,200,100,50
graphicbox #w1.g40, 700,200,100,50
graphicbox #w1.g41, 0,250,100,50
graphicbox #w1.g42, 100,250,100,50
graphicbox #w1.g43, 200,250,100,50
graphicbox #w1.g44, 300,250,100,50
graphicbox #w1.g45, 400,250,100,50
graphicbox #w1.g46, 500,250,100,50
graphicbox #w1.g47, 600,250,100,50
graphicbox #w1.g48, 700,250,100,50
texteditor #w1.t1, 200,350,220,100
button #w1.b1, "Close",[Close#w1],UL,550,430,50,20
button #w1.b2, "Show Available",showAvailable,UL,250,460,100,20
button #w1.b3, "Show Allocated",showAllocated,UL,250,490,100,20
statictext #w1.s1, st$, 500, 350,200,60
statictext #w1.s2, "Conference Seat allocation plan", 260, 310,320,25
open "" for window_popup as #w1
'remove menubar from window
hw1=hwnd(#w1)
CallDLL #user32, "SetMenu",hw1 As Long,0 As Long, r As void
#w1.s2, "!font arial 16 underscore"
c=0
t=0
fillColor$(0)="255 245 238"
fillColor$(1)="245 222 179"
for i=1 to 48
'ensure checkerboard pattern
if c=8 then c=0:t=ABS(NOT(t))
'use handle variable
hVar$="#w1.g"+str$(i)
#hVar$, "font courier_new 9"
#hVar$, "down;fill ";fillColor$(t);";backcolor ";fillColor$(t)
#hVar$, "line 0 25 100 25;line 50 0 50 25;set 20 17;\";i;"A"
#hVar$, "set 60 17;\";i;"B"
#hVar$, "set 40 40;\";i;"C"
#hVar$, "flush"
'use subs as event handlers for mouseclicks
#hVar$, "when leftButtonUp GbID;when rightButtonUp GbRst;when middleButtonUp mbu"
'alternate fill colour
t=ABS(NOT(t))
c=c+1
next i
wait
[Close#w1]
close #w1
end
'handler for left mouse button
sub GbID hGb$,x,y
#w1.t1, "!cls"
'#w1.t1, "Handle of selected graphicbox=";hGb$
cn=val(mid$(hGb$,6))
py=17
select case
case y<25 and x<50
subDiv$="A":px=20:seatA$(1,cn)="Allocated":seatA$(2,cn)=getDelegateName$()
case y<25 and x>50
subDiv$="B":px=60:seatB$(1,cn)="Allocated":seatB$(2,cn)=getDelegateName$()
case else
subDiv$="C":px=40:py=40:seatC$(1,cn)="Allocated":seatC$(2,cn)=getDelegateName$()
end select
#hGb$, "color red;set ";px;" ";py;";\";cn;subDiv$
#w1.t1, "Seat number ";cn;subDiv$;" allocated"
end sub
'handler for right mouse button
sub GbRst hGb$,x,y
#w1.b1, "!disable"
cn=val(mid$(hGb$,6))
#w1.t1, "!cls"
py=17
select case
case y<25 and x<50
subDiv$="A ":px=20:seatA$(1,cn)="Available":seatA$(2,cn)=""
case y<25 and x>50
subDiv$="B":px=60:seatB$(1,cn)="Available":seatB$(2,cn)=""
case else
subDiv$="C ":px=40:py=40:seatC$(1,cn)="Available":seatC$(2,cn)=""
end select
#hGb$, "color black;set ";px;" ";py;";\";cn;subDiv$
#w1.t1, "Seat ";cn;subDiv$;" cancelled"
#w1.b1, "!enable"
end sub
sub mbu hGb$,x,y
cn$=mid$(hGb$,6)
notice "Middle mouse button clicked";chr$(13);"at coords ";x;", ";y;_
chr$(13);"in cell number ";cn$
end sub
sub showAvailable h$
#w1.t1, "!cls"
for i=1 to 48
if seatA$(1,i)="Available" then #w1.t1, i;"A ";seatA$(1,i)
if seatB$(1,i)="Available" then #w1.t1, i;"B ";seatB$(1,i)
if seatC$(1,i)="Available" then #w1.t1, i;"C ";seatC$(1,i)
next i
end sub
sub showAllocated h$
#w1.t1, "!cls"
for i=1 to 48
if seatA$(1,i)="Allocated" then #w1.t1, i;"A ";seatA$(1,i);" ";seatA$(2,i)
if seatB$(1,i)="Allocated" then #w1.t1, i;"B ";seatB$(1,i);" ";seatB$(2,i)
if seatC$(1,i)="Allocated" then #w1.t1, i;"C ";seatC$(1,i);" ";seatC$(2,i)
next i
end sub
function getDelegateName$()
prompt "Allocate seat"+chr$(13)+"Delegates name";getDelegateName$
if getDelegateName$="" then getDelegateName$="Unknown"
end function
'End of code
No doubt LBers will find many other situations where the code could be applied.